home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctjoc85.arc / FATFISH.PAS < prev    next >
Pascal/Delphi Source File  |  1985-08-07  |  14KB  |  532 lines
  1. { WA-TOR program -- Inspired by Scientific American, 12/84 }
  2.  
  3. {$debug+}                                      {1}
  4. {$entry+}                       {1}
  5. {$line+}                       {1}    
  6.  
  7. PROGRAM wator(input,output) ;
  8.  
  9.   { pascal library functions }
  10.  
  11.   FUNCTION umulok(a,b:word ; VAR c:word) : boolean ;     {4}
  12.     EXTERN ;                         {4}
  13.  
  14.   FUNCTION tics : word ;                 {6}
  15.     EXTERN ;                         {6}
  16.  
  17.   { assembly language utilities }
  18.  
  19.   PROCEDURE set_cursor(row,column: integer) ;
  20.     EXTERN ;
  21.  
  22.   PROCEDURE clear_screen ;
  23.     EXTERN ;
  24.  
  25.   PROCEDURE install_break_handler ;
  26.     EXTERN ;
  27.  
  28.   FUNCTION check_break : boolean ;
  29.     EXTERN ;
  30.  
  31.   PROCEDURE remove_break_handler ;
  32.     EXTERN ;
  33.  
  34.   CONST
  35.  
  36.     { describe the size of the wator world }
  37.  
  38.     xsize = 79 ;                       { horizontal size of wator  }
  39.     maxx = 78 ;                        { xsize -1                  }
  40.     ysize = 20 ;                       { vertical size of wator    }
  41.     maxy = 19 ;                        { ysize -1                  }
  42.  
  43.   TYPE
  44.  
  45.     { describe the fish lists used to keep track of wator's beings }
  46.  
  47.     species = (fish,shark,empty) ;
  48.     xcoord = 0..maxx ;
  49.     ycoord = 0..maxy ;
  50.     link = ^fishes ;                {5}
  51.     fishes = RECORD
  52.                next : link ;
  53.                prev : link ;
  54.                kind : species ;
  55.                age : integer ;
  56.                x : xcoord ;
  57.                y : ycoord ;
  58.                ate : integer ;
  59.              END ;
  60.  
  61.     { identify the neighbors of a given fish or shark }
  62.  
  63.     neighbor = RECORD
  64.                  x : integer ;
  65.                  y : integer ;
  66.                  kind : species ;
  67.                END ;
  68.     neighborhood = ARRAY [1..8] OF neighbor ;
  69.  
  70.   VAR
  71.  
  72.     { heads and tails of the lists of beings on wator }
  73.  
  74.     fish_head : link ;
  75.     fish_tail : link ;
  76.     shark_head : link ;
  77.     shark_tail : link ;
  78.  
  79.     { array to identify what is currently at a place in wator }
  80.  
  81.     pond : ARRAY [xcoord,ycoord] OF species ;
  82.  
  83.     { variables that describe the characteristics of wator }
  84.  
  85.     nfishes : integer ;           { init number of fishes in pond  }
  86.     nsharks : integer ;           { init number of sharks in pond  }
  87.     sbreed : integer ;            { chronons btwn shark breeding   }
  88.     fbreed : integer ;            { chronons btwn fish  breeding   }
  89.     starve : integer ;            { time a shark can go w/o eating }
  90.  
  91.     { miscellaneous variables }
  92.  
  93.     generation : integer ;
  94.     counts : ARRAY [fish..shark] OF integer ;
  95.     neighbors : ARRAY [1..4] OF neighbor ;
  96.     abort : boolean;
  97.     seed : word ;
  98.  
  99.   { utility function to implement universe wrapping }
  100.  
  101.   FUNCTION wrap(c,l:integer) : integer ;
  102.  
  103.     BEGIN
  104.       c := c MOD l ;
  105.       IF c < 0 THEN
  106.         c := c + l ;
  107.       wrap := c ;
  108.     END ;
  109.  
  110.   { random number generator }
  111.  
  112.   FUNCTION random(max_index:integer) : integer ;
  113.  
  114.     VAR
  115.       overflow : boolean ;
  116.  
  117.     BEGIN
  118.       overflow := umulok(15625,seed,seed) ;                          {4}
  119.       random := trunc(max_index*(abs(float(ord(seed)))/32768.0)) ;   {4}
  120.     END ;
  121.  
  122.   { procedure to display a fish (or water) at a given location }
  123.  
  124.   PROCEDURE display_fish(x:xcoord ;
  125.                          y:ycoord ;
  126.                          t:species) ;
  127.  
  128.     BEGIN
  129.       set_cursor(y,x) ;                {3}
  130.       IF t = fish THEN
  131.         BEGIN
  132.           write(',');                 {3}
  133.         END
  134.       ELSE IF t = shark THEN
  135.         BEGIN
  136.           write('δ');                {3}
  137.         END
  138.       ELSE
  139.         write(' ');                {3}
  140.       pond[x,y] := t ;
  141.     END ;
  142.  
  143.   { procedure to add a new fish (or shark) to the pond }
  144.  
  145.   PROCEDURE add_fish(p:link ;
  146.                      p_kind:species ;
  147.                      p_x:xcoord ;
  148.                      p_y:ycoord) ;
  149.  
  150.     VAR
  151.       t : link ;
  152.  
  153.     BEGIN
  154.       new(t) ;                    {5}
  155.       counts[p_kind] := counts[p_kind] + 1 ;
  156.       WITH t^ DO
  157.         BEGIN
  158.           next := p^.next ;
  159.           prev := p ;
  160.           kind := p_kind ;
  161.           age := 0 ;
  162.           x := p_x ;
  163.           y := p_y ;
  164.           ate := 0 ;
  165.           display_fish(p_x,p_y,p_kind) ;
  166.         END ;
  167.       p^.next^.prev := t ;
  168.       p^.next := t ;
  169.     END ;
  170.  
  171.   { procedure to delete an entry from a fish list }
  172.  
  173.   PROCEDURE delete_fish(p:link) ;
  174.  
  175.     BEGIN
  176.       WITH p^ DO
  177.         BEGIN
  178.           counts[p^.kind] := counts[p^.kind] - 1 ;
  179.           prev^.next := next ;
  180.           next^.prev := prev ;
  181.           display_fish(x,y,empty) ;
  182.           dispose(p) ;
  183.         END ;
  184.     END ;
  185.  
  186.   { procedure to check the pond around a given fish/shark }
  187.  
  188.   PROCEDURE check_pond(p_x:xcoord ;
  189.                        p_y:ycoord ;
  190.                        t:species ;
  191.                        VAR n:integer ;
  192.                        VAR a:neighborhood) ;
  193.  
  194.     VAR
  195.       tx : xcoord ;
  196.       ty : ycoord ;
  197.       i : integer ;
  198.  
  199.     BEGIN
  200.       n := 0 ;
  201.       FOR i := 1 TO 4 DO
  202.         BEGIN
  203.           tx := wrap(p_x+neighbors[i].x,xsize) ;
  204.           ty := wrap(p_y+neighbors[i].y,ysize) ;
  205.           IF pond[tx,ty] = t THEN
  206.             BEGIN
  207.               n := n + 1 ;
  208.               WITH a[n] DO
  209.                 BEGIN
  210.                   x := tx ;
  211.                   y := ty ;
  212.                   kind := pond[tx,ty] ;
  213.                 END ;
  214.             END ;
  215.         END ;
  216.     END ;
  217.  
  218.   { procedure to make fish swim }
  219.  
  220.   PROCEDURE fish_swim ;
  221.  
  222.     VAR
  223.       f_link : link ;
  224.       f_n : integer ;
  225.       f_nghbr : neighborhood ;
  226.       old_x : xcoord ;
  227.       old_y : ycoord ;
  228.       r : integer ;
  229.  
  230.     BEGIN
  231.       f_link := fish_head^.next ;
  232.       WHILE (f_link <> fish_tail) DO
  233.         WITH f_link^ DO
  234.           BEGIN
  235.             IF check_break THEN
  236.               BEGIN
  237.                 abort := true ;
  238.                 break ;
  239.               END;
  240.             check_pond(x,y,empty,f_n,f_nghbr) ;
  241.             IF f_n > 0 THEN
  242.               BEGIN
  243.                 old_x := x ;
  244.                 old_y := y ;
  245.                 r := random(f_n) + 1 ;
  246.                 display_fish(x,y,empty) ;
  247.                 x := f_nghbr[r].x ;
  248.                 y := f_nghbr[r].y ;
  249.                 display_fish(x,y,fish) ;
  250.                 IF age >= fbreed THEN
  251.                   BEGIN
  252.                     add_fish(fish_head,fish,old_x,old_y) ;
  253.                     age := 0 ;
  254.                   END
  255.                 ELSE
  256.                   age := age + 1 ;
  257.               END
  258.             ELSE
  259.               age := age + 1 ;
  260.             f_link := next ;
  261.           END ;
  262.     END ;
  263.  
  264.   { procedure where a fish turns into a shark nummy }
  265.  
  266.   PROCEDURE eat_fish(p_x:xcoord ;
  267.                      p_y:ycoord) ;
  268.  
  269.     VAR
  270.       f_link : link ;
  271.       eaten : boolean ;
  272.  
  273.     BEGIN
  274.       eaten := false ;
  275.       f_link := fish_head^.next ;
  276.       WHILE (f_link<>fish_tail) AND ( NOT eaten) DO
  277.         WITH f_link^ DO
  278.           IF (x = p_x) AND (y = p_y) THEN
  279.             BEGIN
  280.               delete_fish(f_link) ;
  281.               f_link := NIL ;
  282.               eaten := true ;
  283.             END
  284.           ELSE
  285.             f_link := next ;
  286.     END ;
  287.  
  288.   { shark hunt and breeding procedure }
  289.  
  290.   PROCEDURE shark_move ;
  291.  
  292.     LABEL
  293.       next_shark ;
  294.  
  295.     VAR
  296.       s_link : link ;
  297.       s_n : integer ;
  298.       s_nghbr : neighborhood ;
  299.       old_x : xcoord ;
  300.       old_y : ycoord ;
  301.       r : integer ;
  302.  
  303.     BEGIN
  304.       s_link := shark_head^.next ;
  305.       WHILE (s_link <> shark_tail) DO
  306.         WITH s_link^ DO
  307.           BEGIN
  308.             IF check_break THEN
  309.               BEGIN
  310.                 abort := true;
  311.                 break;
  312.               END;
  313.  
  314.             { feeding section }
  315.  
  316.             check_pond(x,y,fish,s_n,s_nghbr) ;
  317.             IF s_n > 0 THEN
  318.               BEGIN
  319.                 old_x := x ;
  320.                 old_y := y ;
  321.                 r := random(s_n) + 1 ;
  322.                 display_fish(x,y,empty) ;
  323.                 x := s_nghbr[r].x ;
  324.                 y := s_nghbr[r].y ;
  325.                 eat_fish(x,y) ;
  326.                 display_fish(x,y,shark) ;
  327.                 ate := 0 ;
  328.                 IF age >= sbreed THEN
  329.                   BEGIN
  330.                     add_fish(shark_head,shark,old_x,old_y) ;
  331.                     age := 0 ;
  332.                   END
  333.                 ELSE
  334.                   age := age + 1 ;
  335.                 s_link := next ;
  336.                 GOTO next_shark ;
  337.               END ;
  338.  
  339.             { starvation section }
  340.  
  341.             ate := ate + 1 ;
  342.             IF ate > starve THEN
  343.               BEGIN
  344.                 set_cursor(ysize+4,40) ;
  345.                 write
  346.                 ('shark at position (',y:2,',',x:2,') starved...') ;
  347.                 s_link := next ;
  348.                 delete_fish(s_link^.prev) ;
  349.                 GOTO next_shark ;
  350.               END ;
  351.  
  352.             { move to unoccupied section }
  353.  
  354.             check_pond(x,y,empty,s_n,s_nghbr) ;
  355.             IF s_n > 0 THEN
  356.               BEGIN
  357.                 old_x := x ;
  358.                 old_y := y ;
  359.                 r := random(s_n) + 1 ;
  360.                 display_fish(x,y,empty) ;
  361.                 x := s_nghbr[r].x ;
  362.                 y := s_nghbr[r].y ;
  363.                 display_fish(x,y,shark) ;
  364.                 IF age >= sbreed THEN
  365.                   BEGIN
  366.                     add_fish(shark_head,shark,old_x,old_y) ;
  367.                     age := 0 ;
  368.                   END
  369.                 ELSE
  370.                   age := age + 1 ;
  371.                 s_link := next ;
  372.                 GOTO next_shark ;
  373.               END ;
  374.  
  375.             { if we get here, the shark just gets older }
  376.  
  377.             age := age + 1 ;
  378.             s_link := next ;
  379.             GOTO next_shark ;
  380. next_shark:
  381.           END ;
  382.     END ;
  383.  
  384.   { initialization procedure }
  385.  
  386.   PROCEDURE init ;
  387.  
  388.     VAR
  389.       i : integer ;
  390.       tx : xcoord ;
  391.       ty : ycoord ;
  392.       tt : boolean ;
  393.  
  394.     BEGIN
  395.       clear_screen ;
  396.       set_cursor(0,0) ;
  397.       writeln('Welcome to WA-TOR.') ;
  398.       writeln('How many fishes does WA-TOR have?') ;
  399.       writeln('Pick a number between 1..1000.  Try 200.') ;
  400.       read(i) ;
  401.       IF (i>1000) OR (i<1) THEN
  402.         nfishes := 200
  403.       ELSE
  404.         nfishes := i ;
  405.       writeln('How many sharks does WA-TOR have?') ;
  406.       writeln('Pick a number between 1..200.  Try 20.') ;
  407.       read(i) ;
  408.       IF (i>200) OR (i<1) THEN
  409.         nsharks := 20
  410.       ELSE
  411.         nsharks := i ;
  412.       writeln('How often do the fish breed?') ;
  413.       writeln('Pick a between 1..100 chronons.  Try 3 chronons.') ;
  414.       read(i) ;
  415.       IF (i>100) OR (i<1) THEN
  416.         fbreed := 3
  417.       ELSE
  418.         fbreed := i ;
  419.       writeln('How often do the sharks breed?') ;
  420.       writeln('Pick a between 1..100 chronons.  Try 10 chronons.') ;
  421.       read(i) ;
  422.       IF (i>100) OR (i<1) THEN
  423.         sbreed := 10
  424.       ELSE
  425.         sbreed := i ;
  426.       writeln('How long can a shark go without eating?') ;
  427.       writeln('Pick a between 1..100 chronons.  Try 3 chronons.') ;
  428.       read(i) ;
  429.       IF (i>100) OR (i<1) THEN
  430.         starve := 3
  431.       ELSE
  432.         starve := i ;
  433.       clear_screen;
  434.       set_cursor(ysize+1,40) ;
  435.       write('fish breed every ',fbreed:3,' chronons') ;
  436.       set_cursor(ysize+2,40) ;
  437.       write('sharks breed every ',sbreed:3,' chronons') ;
  438.       set_cursor(ysize+3,40) ;
  439.       write('sharks starve after ',starve:3,' chronons') ;
  440.       set_cursor(ysize+4,0) ;
  441.       write('Press Ctrl-Break to end WA-TOR...') ;
  442.       abort := false;
  443.       seed := tics ;
  444.       neighbors[1].x := 0 ;
  445.       neighbors[1].y := - 1 ;
  446.       neighbors[2].x := - 1 ;
  447.       neighbors[2].y := 0 ;
  448.       neighbors[3].x := 1 ;
  449.       neighbors[3].y := 0 ;
  450.       neighbors[4].x := 0 ;
  451.       neighbors[4].y := 1 ;
  452.       new(fish_head) ;
  453.       new(fish_tail) ;
  454.       new(shark_head) ;
  455.       new(shark_tail) ;
  456.       fish_head^.next := fish_tail ;
  457.       fish_head^.prev := NIL ;
  458.       fish_tail^.next := NIL ;
  459.       fish_tail^.prev := fish_head ;
  460.       shark_head^.next := shark_tail ;
  461.       shark_head^.prev := NIL ;
  462.       shark_tail^.next := NIL ;
  463.       shark_tail^.prev := shark_head ;
  464.       counts[fish] := 0 ;
  465.       counts[shark] := 0 ;
  466.       generation := 1 ;
  467.       FOR tx := 0 TO maxx DO
  468.         FOR ty := 0 TO maxy DO
  469.           pond[tx,ty] := empty ;
  470.       FOR i := 1 TO nfishes DO
  471.         BEGIN
  472.           tt := true ;
  473.           WHILE tt DO
  474.             BEGIN
  475.               tx := random(xsize) ;
  476.               ty := random(ysize) ;
  477.               IF pond[tx,ty] = empty THEN
  478.                 BEGIN
  479.                   add_fish(fish_head,fish,tx,ty) ;
  480.                   fish_head^.next^.age := random(fbreed) ;
  481.                   tt := false ;
  482.                 END ;
  483.             END ;
  484.         END ;
  485.       FOR i := 1 TO nsharks DO
  486.         BEGIN
  487.           tt := true ;
  488.           WHILE tt DO
  489.             BEGIN
  490.               tx := random(xsize) ;
  491.               ty := random(ysize) ;
  492.               IF pond[tx,ty] = empty THEN
  493.                 BEGIN
  494.                   add_fish(shark_head,shark,tx,ty) ;
  495.                   WITH shark_head^.next^ DO
  496.                     BEGIN
  497.                       age := random(sbreed) ;
  498.                       ate := random(starve) ;
  499.                     END ;
  500.                   tt := false ;
  501.                 END ;
  502.             END ;
  503.         END ;
  504.     END ;
  505.  
  506.   { main program }
  507.  
  508.   BEGIN
  509.     init ;
  510.     install_break_handler ;
  511.     WHILE ((fish_head^.next <> fish_tail) OR
  512.           (shark_head^.next <> shark_tail)) AND
  513.           (NOT abort) DO
  514.       BEGIN
  515.         set_cursor(ysize+1,0) ;
  516.         write('fishes     = ',counts[fish]:4) ;
  517.         set_cursor(ysize+2,0) ;
  518.         write('sharks     = ',counts[shark]:4) ;
  519.         set_cursor(ysize+3,0) ;
  520.         write('generation = ',generation:4) ;
  521.         fish_swim ;
  522.         shark_move ;
  523.         generation := generation + 1 ;
  524.       END;
  525.     clear_screen ;
  526.     set_cursor(0,0) ;
  527.     IF (fish_head^.next = fish_tail) AND
  528.        (shark_head^.next = shark_tail) THEN
  529.       writeln('All life on WA-TOR extinct...') ;
  530.     remove_break_handler ;
  531.   END.
  532.